// System Unit
// Extension Support

(*************)
(* Interface *)
(*************)
{$IFDEF Include_Modules_Header}

 Const
  RTLEx_Slots = 16;

 // WARNING: Thread-unsafe! Must be called serially
 // (Note that these function are normally called during unit initialization/finalization,
 //  which are called serially, so nothing special is needed)
 Function RTLEx_Alloc(Const xName: PChar): Cardinal;
 Procedure RTLEx_Free(Const Handle: Cardinal);

 Function RTLEx_Get(Const LibModule: PLibModule; Const Handle: Cardinal): Pointer;
 Procedure RTLEx_Set(Const LibModule: PLibModule; Const Handle: Cardinal; xData: Pointer);

{$ENDIF Include_Modules_Header}
(******************)
(* Implementation *)
(******************)
{$IFDEF Include_Modules_Implement}

 ResourceString
  _RTL_ResStr_RTLExFinalize = 'Runtime library extension leak: ';

 Type
  // TFLDLItem compatible!
  PRTLExRec = ^TRTLExRec;
  TRTLExRec = Record
   Name: PChar;
   Reserved: Pointer;
   Next, Prev: PRTLExRec;
  END;

  // TFLDLHeader compatible!
  TRTLExHeader = Record
   MaxSize, MinFree: Cardinal;
   Head, Tail: PRTLExRec;
  END;

  // TFLDL compatible!
  TRTLExSlots = Record
   Header: TRTLExHeader;
   List: Array[0..RTLEx_Slots-1] of TRTLExRec;
  END;

 Var
  _INT_RTLExSlots: TRTLExSlots;

 Function RTLEx_Alloc(Const xName: PChar): Cardinal;
  BEGIN
   IF NOT Assigned(xName)
   then System.Error(reInvalidPtr);

   Result:= FLDL_Alloc(_INT_RTLExSlots);
   With _INT_RTLExSlots.List[Result] do
    Name:= xName;
  END;

 Procedure RTLEx_Free(Const Handle: Cardinal);
  BEGIN
   FLDL_Free(_INT_RTLExSlots, Handle);
  END;

 Procedure RTLEx_Finalize;
  Procedure _LOC_LogRTLExLeak(Const Name: PChar);
   Var
    ErrorMsg: Array [0..RTL_ResStr_MsgLen] of Char;
    MsgLen: Cardinal;
   BEGIN
    MsgLen:= LoadResStringFx(@_RTL_ResStr_RTLExFinalize, ErrorMsg, RTL_ResStr_MsgLen+1);
    RTL_PWideCharCopyNPtr(@ErrorMsg[MsgLen], Name, RTL_ResStr_MsgLen-MsgLen+1)^:= #0;
    Log(llWarn, ErrorMsg);
   END;
  Var
   RTLExRec: PRTLExRec;
  BEGIN
   RTLExRec:= _INT_RTLExSlots.Header.Tail;
   While Assigned(RTLExRec) do
    BEGIN
     _LOC_LogRTLExLeak(RTLExRec.Name);
     RTLExRec:= RTLExRec.Prev;
    END;
  END;

 Function RTLEx_Get(Const LibModule: PLibModule; Const Handle: Cardinal): Pointer;
  BEGIN
   IF Handle >= RTLEx_Slots
   then System.Error(reRangeError);

   Result:= PRTLExSlot_Local(LibModule.RTLEx)[Handle];
  END;

 Procedure RTLEx_Set(Const LibModule: PLibModule; Const Handle: Cardinal; xData: Pointer);
  BEGIN
   IF Handle >= RTLEx_Slots
   then System.Error(reRangeError);

   PRTLExSlot_Local(LibModule.RTLEx)[Handle]:= xData;
  END;

{$ENDIF Include_Modules_Implement}
(******************)
(* Initialization *)
(******************)
{$IFDEF Include_Modules_Initialize}

 FLDL_Init(_INT_RTLExSlots, RTLEx_Slots);

{$ENDIF Include_Modules_Initialize}
(****************)
(* Finalization *)
(****************)
{$IFDEF Include_Modules_Finalize}

 RTLEx_Finalize;

{$ENDIF Include_Modules_Finalize}
